**free

// To Compile:
//
// *>   CRTRPGMOD MODULE(UDTFDEMO1) SRCFILE(QRPGLESRC) DBGVIEW(*LIST)
// *>   CRTSRVPGM SRVPGM(UDTFDEMO1) EXPORT(*ALL)

ctl-opt nomain option(*srcstmt);

dcl-f ITMMAST  disk usage(*input) keyed usropn;
dcl-f CUSTMAS  disk usage(*input) keyed usropn;
dcl-f ORDBYCUS disk usage(*input) keyed usropn;

dcl-c CALL_OPEN     -1;
dcl-c CALL_FETCH     0;
dcl-c CALL_CLOSE     1;
dcl-c PARM_NULL     -1;
dcl-c PARM_NOTNULL   0;

dcl-proc CustSales export;

  dcl-pi *n;
    CustNo   packed(4: 0) const;
    Date     packed(8: 0) const;
    itemNo   char(10);
    desc     char(25);
    qty      packed(9: 0);
    unit     char(3);
    weight   packed(11: 2);
    cost     packed(9: 2);
    n_CustNo int(5) const;
    n_date   int(5) const;
    n_ItemNo int(5);
    n_Desc   int(5);
    n_Qty    int(5);
    n_Unit   int(5);
    n_Weight int(5);
    n_Cost   int(5);
    state    char(5);
    Function varchar(517) const;
    Specific varchar(128) const;
    errorMsg varchar(1000);
    CallType int(10) const;
  end-pi;

  if n_Date=PARM_NULL or n_CustNo=PARM_NULL;
     State    = '38999';
     errorMsg = 'Both CUSTNO and DATE are manditory';
     return;
  endif;

  select;
  when CallType = CALL_OPEN;
     exsr doOpen;
  when CallType = CALL_FETCH;
     exsr doFetch;
  when CallType = CALL_CLOSE;
     exsr doClose;
  endsl;

  return;


  begsr doOpen;

    if not %open(CUSTMAS);
       open CUSTMAS;
    endif;
    if not %open(ITMMAST);
       open ITMMAST;
    endif;
    if not %open(ORDBYCUS);
       open ORDBYCUS;
    endif;

    chain (CustNo) CUSTMAS;
    if not %found;
       State    = '38998';
       errorMsg = 'Unknown customer';
       return;
    endif;

    setll (CustNo:Date) ORDBYCUS;
  endsr;


  begsr doFetch;

    reade (CustNo:Date) ORDBYCUS;
    if %eof;
      State = '02000';
      return;
    endif;

    ItemNo = ocItem;
    Qty    = ocQty;
    cost   = ocPric * ocQty;

    chain (%dec(%trim(ItemNo):5:0)) ITMMAST;
    if not %found;
      State    = '38998';
      errorMsg = 'Unknown item found in list';
      return;
    endif;

    Desc = imDesc;

    select;
    when ocUnit = 'L';
      Unit = 'Lbs';
      Weight = Qty;

    when ocUnit = 'B';
      Unit = 'Bxs';
      Weight = Qty * imLbBx;

    when ocUnit = 'P';
      Unit = 'Pcs';
      Weight = Qty * imLbPc;

    when ocUnit = 'Z';
      Unit = 'Plt';
      Weight = Qty * imLbPl;

    endsl;

    Cost = Cost * cuDPct;
  endsr;


  begsr doClose;
    close *ALL;
  endsr;

end-proc;
 